<%
Class FastAsp_Image
    Private m_Image      '图片对象
    Private m_Width      '宽度
    Private m_Height     '高度
    Private m_Quality    '质量
    Private m_Error      '错误信息
    Private m_ImageType  '图片处理组件类型
    
    Private Sub Class_Initialize()
        m_Width = GetConfig("ImageWidth")
        If m_Width = "" Then m_Width = 800
        m_Height = GetConfig("ImageHeight")
        If m_Height = "" Then m_Height = 800
        m_Quality = GetConfig("ImageQuality")
        If m_Quality = "" Then m_Quality = 80
        
        '尝试创建图片处理组件
        On Error Resume Next
        Set m_Image = Server.CreateObject("Persits.Jpeg")
        If Err.Number = 0 Then
            m_ImageType = "Persits"
        Else
            Set m_Image = Server.CreateObject("GflAx.GflAx")
            If Err.Number = 0 Then
                m_ImageType = "GflAx"
            Else
                m_Error = "未安装图片处理组件"
            End If
        End If
        On Error Goto 0
    End Sub
    
    '打开图片
    Public Function Open(byval file)
        If m_Error <> "" Then
            Set Open = Nothing
            Exit Function
        End If
        
        On Error Resume Next
        Select Case m_ImageType
            Case "Persits"
                m_Image.Open Server.MapPath(file)
            Case "GflAx"
                m_Image.LoadBitmap Server.MapPath(file)
        End Select
        
        If Err.Number <> 0 Then
            m_Error = "打开图片失败: " & Err.Description
            Set Open = Nothing
            Exit Function
        End If
        On Error Goto 0
        Set Open = Me
    End Function
    
    '设置宽度
    Public Function Width(byval newWidth)
        m_Width = newWidth
        Set Width = Me
    End Function
    
    '设置高度
    Public Function Height(byval newHeight)
        m_Height = newHeight
        Set Height = Me
    End Function
    
    '设置质量
    Public Function Quality(byval newQuality)
        m_Quality = newQuality
        Set Quality = Me
    End Function
    
    '调整大小
    Public Function Resize()
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        Select Case m_ImageType
            Case "Persits"
                If m_Image.OriginalWidth > m_Width Or m_Image.OriginalHeight > m_Height Then
                    m_Image.Width = m_Width
                    m_Image.Height = m_Height
                End If
            Case "GflAx"
                If m_Image.Width > m_Width Or m_Image.Height > m_Height Then
                    m_Image.Resize m_Width, m_Height, 1  '1=高质量缩放
                End If
        End Select
        
        If Err.Number <> 0 Then
            m_Error = "调整大小失败: " & Err.Description
        End If
        On Error Goto 0
        Set Resize = Me
    End Function
    
    '裁剪图片
    Public Function Crop(byval x, byval y, byval cropWidth, byval cropHeight)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        Select Case m_ImageType
            Case "Persits"
                m_Image.Crop x, y, cropWidth, cropHeight
            Case "GflAx"
                m_Image.Crop x, y, cropWidth, cropHeight
        End Select
        
        If Err.Number <> 0 Then
            m_Error = "裁剪图片失败: " & Err.Description
        End If
        On Error Goto 0
        Set Crop = Me
    End Function
    
    '添加水印
    Public Function Watermark(byval text, byval x, byval y, byval color, byval fontSize)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        Select Case m_ImageType
            Case "Persits"
                m_Image.Canvas.Font.Color = color
                m_Image.Canvas.Font.Size = fontSize
                m_Image.Canvas.Print x, y, text
            Case "GflAx"
                m_Image.DrawText text, x, y, fontSize, color
        End Select
        
        If Err.Number <> 0 Then
            m_Error = "添加水印失败: " & Err.Description
        End If
        On Error Goto 0
        Set Watermark = Me
    End Function
    
    '保存图片
    Public Function Save(byval file)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        '创建目录
        CreateFolder Server.MapPath(GetFolderPath(file))
        
        '保存图片
        Select Case m_ImageType
            Case "Persits"
                m_Image.Quality = m_Quality
                m_Image.Save Server.MapPath(file)
            Case "GflAx"
                m_Image.SaveJPG Server.MapPath(file), m_Quality
        End Select
        
        If Err.Number <> 0 Then
            m_Error = "保存图片失败: " & Err.Description
            Set Save = Nothing
            Exit Function
        End If
        On Error Goto 0
        Set Save = Me
    End Function
    
    '输出图片
    Public Sub Output()
        If m_Error <> "" Then Exit Sub
        
        Response.Clear
        Response.ContentType = "image/jpeg"
        
        On Error Resume Next
        Select Case m_ImageType
            Case "Persits"
                m_Image.Quality = m_Quality
                m_Image.SendBinary
            Case "GflAx"
                Response.BinaryWrite m_Image.GetJPGBuffer(m_Quality)
        End Select
        
        If Err.Number <> 0 Then
            m_Error = "输出图片失败: " & Err.Description
        End If
        On Error Goto 0
        Response.End
    End Sub
    
    '获取错误信息
    Public Property Get Error_()
        Error_ = m_Error
    End Property
    
    '获取文件夹路径
    Private Function GetFolderPath(byval file)
        GetFolderPath = Left(file, InStrRev(file, "/"))
    End Function
    
    '创建文件夹
    Private Sub CreateFolder(byval path)
        Dim fso : Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If Not fso.FolderExists(path) Then
            CreateFolder fso.GetParentFolderName(path)
            fso.CreateFolder path
        End If
        Set fso = Nothing
    End Sub
    
    Private Sub Class_Terminate()
        Set m_Image = Nothing
    End Sub
End Class
%> 